home *** CD-ROM | disk | FTP | other *** search
/ Power Programmierung / Power-Programmierung (Tewi)(1994).iso / magazine / nvdc87 / julian / chrono.tb < prev    next >
Text File  |  1987-05-20  |  2KB  |  89 lines
  1. ' CHRONO.TB:    Julian Date functions
  2. '
  3. ' version:      05-20-87
  4. ' compiler:     Turbo BASIC v1.0
  5. ' uses:         nothing
  6. ' module type:  include file
  7. '
  8. ' This file contains functions to work with calendar dates.  A
  9. ' calendar date is a real number in the format YYMMDD.  For
  10. ' example, 4/23/87 would be 870423.  Julian dates are "magic"
  11. ' hashed versions of calendar dates that allow arithmetic,
  12. ' determining the day of the week, etc.  without consulting an
  13. ' actual calendar.
  14. '
  15. ' Functions in this file:
  16. '
  17. ' FNYear(D)         Returns the year part of a calendar date
  18. ' FNDay(D)          Returns the day part of a calendar date
  19. ' FNMonth(D)        Returns the month part of a calendar date
  20. ' FNJulian(D)       Converts a calendar date to a julian date
  21. ' FNCalendar(J)     Converts a julian date to a calendar date
  22. ' FNDayOfWeek(J)    Returns day of week for a julian date
  23. ' FNToday           Returns today's date (from DOS) as calendar
  24. '                   date
  25.  
  26. DEF FNYear(Cal)
  27.   ' Return the year in a calendar date.
  28.   FNYear = INT(Cal/10000)
  29. END DEF
  30.  
  31. DEF FNDay(Cal)
  32.   ' Return the day in a calendar date.
  33.   FNDay = INT(Cal-(INT(Cal/100)*100))
  34. END DEF
  35.  
  36. DEF FNMonth(Cal)
  37.   ' Return the month in a calendar date.
  38.   FNMonth = INT((Cal-(FNYear(Cal)*10000)-FNDay(Cal))/100)
  39. END DEF
  40.  
  41. DEF FNJulian(Cal)
  42.   ' Convert a calendar date into a Julian date
  43.   LOCAL m,y
  44.   IF FNMonth(Cal) > 2 THEN
  45.     m = FNMonth(Cal)+1
  46.     y = FNYear(Cal)
  47.   ELSE
  48.     m = FNMonth(Cal)+13
  49.     y = FNYear(Cal)-1
  50.   END IF
  51.   FNJulian = INT(365.25*(1900+y))+INT(30.6001*m)+FNDay(Cal)+1720982
  52. END DEF
  53.  
  54. DEF FNCalendar(Jul)
  55.   ' Convert a Julian date into a calendar date
  56.   LOCAL m,d,y,DayNo
  57.   DayNo = Jul - 1720982
  58.   y = INT((DayNo-122.1)/365.25)
  59.   m = INT((DayNo-INT(365.25*y))/30.6001)
  60.   d = DayNo-INT(365.25*y)-INT(30.6001*m)
  61.   IF m < 14 THEN
  62.     m = m-1
  63.   ELSE
  64.     m = m-13
  65.   END IF
  66.   IF m < 3 THEN y = y + 1
  67.   FNCalendar = (y-1900)*10000 + m*100 + d
  68. END DEF
  69.  
  70. DEF FNDayOfWeek(Jul)
  71.   ' Convert Julian date to day of week, 0=Sunday
  72.   LOCAL DayNo,X,FracX
  73.   DayNo = Jul - 1720982
  74.   X = (DayNo+5)/7.0
  75.   FracX = X - INT(X)
  76.   FNDayOfWeek = INT(7*FracX+0.5)
  77. END DEF
  78.  
  79. DEF FNToday
  80.   ' Return today's date as a calendar date from MS DOS
  81.   LOCAL m,d,y
  82.   REG 1,&H2A00
  83.   CALL INTERRUPT &H21
  84.   y = REG(3)
  85.   m = INT(REG(4)/256)
  86.   d = REG(4) AND &H00FF
  87.   FNToday = (y-1900)*10000 + m*100 + d
  88. END DEF
  89.